home *** CD-ROM | disk | FTP | other *** search
/ World of Sound / World of Sound.iso / utils / misc / fmsynth / src / source.lha / IntuiSupport.mod < prev    next >
Encoding:
Text File  |  1993-06-27  |  24.2 KB  |  803 lines
  1. (*-------------------------------------------------------------------------
  2.  :Program.       IntuiSupport.mod
  3.  :Contents.      Easy programming of Intuition
  4.  :Author.        Christian Stiens
  5.  :Address.       Heustiege 2, D-59348 Lüdinghausen
  6.  :Copyright.     public domain
  7.  :Language.      Oberon-2
  8.  :Translator.    Amiga Oberon 3.01
  9.  :History.       V1.1, 26-Aug-90: first release
  10.  :History.       V1.2, 25-Jun-92: ported to Oberon, many improvements
  11.  :History.       V1.3, 10-Dez-92: cosmetic changes
  12. -------------------------------------------------------------------------*)
  13.  
  14. MODULE IntuiSupport;
  15.  
  16.   IMPORT
  17.     e  := Exec,
  18.     g  := Graphics,
  19.     I  := Intuition,
  20.     ol := OberonLib,
  21.     rq := Requests,
  22.     str:= Strings,
  23.     u  := Utility,
  24.     SYS:= SYSTEM;
  25.  
  26.   CONST
  27.     autoBorder * = SYS.VAL(I.BorderPtr,1);
  28.  
  29.     stdWin  * = LONGSET{I.windowSizing,I.windowDrag,I.windowDepth,I.activate,I.windowClose,I.noCareRefresh};
  30.     stdIdcmp* = LONGSET{I.closeWindow};
  31.     stdGad  * = I.gadgHComp;
  32.     stdAct  * = {I.gadgImmediate,I.relVerify};
  33.     stdItem * = {I.itemText,I.highComp,I.itemEnabled};
  34.     stdReq  * = {};
  35.     stdHPrp * = {I.freeHoriz,I.autoKnob};
  36.     stdVPrp * = {I.freeVert,I.autoKnob};
  37.     std2Prp * = {I.freeVert,I.freeHoriz,I.autoKnob};
  38.  
  39.     topaz80 * = g.TextAttr(SYS.ADR("topaz.font"),8,SHORTSET{},SHORTSET{});
  40.     topaz60 * = g.TextAttr(SYS.ADR("topaz.font"),9,SHORTSET{},SHORTSET{});
  41.  
  42.   TYPE
  43.     BoolGadgetPtr * = UNTRACED POINTER TO BoolGadget;
  44.     StrGadgetPtr  * = UNTRACED POINTER TO StrGadget;
  45.     PropGadgetPtr * = UNTRACED POINTER TO PropGadget;
  46.  
  47.     BoolGadget * = STRUCT
  48.       (gad * : I. Gadget)
  49.       info * : I.BoolInfo;
  50.     END;
  51.  
  52.     StrGadget * = STRUCT
  53.       (gad * : I.Gadget)
  54.       info * : I.StringInfo;
  55.       ext  * : I.StringExtend;
  56.     END;
  57.  
  58.     PropGadget * = STRUCT
  59.       (gad * : I.Gadget)
  60.       info * : I.PropInfo;
  61.     END;
  62.  
  63.     NewWindowProc * = PROCEDURE (nw: I.NewWindowPtr);
  64.     NewScreenProc * = PROCEDURE (ns: I.ExtNewScreenPtr);
  65.  
  66.   VAR
  67.     autoBorderProc  * : PROCEDURE (le,to,wi,he: INTEGER): I.BorderPtr;
  68.     itemLeftEdge    * : INTEGER;
  69.     itemTopEdge     * : INTEGER;
  70.     blackPen        * : SHORTINT;
  71.     whitePen        * : SHORTINT;
  72.     gadgetFrontPen  * : SHORTINT;
  73.     gadgetBackPen   * : SHORTINT;
  74.     msgFilter       * : LONGSET;
  75.     font            * : g.TextAttrPtr;
  76.     createReqBorder * : BOOLEAN;
  77.     createStrBorder * : BOOLEAN;
  78.     magic             : LONGINT;
  79.     firstMenu       - : I.MenuPtr;
  80.     lastMenu        - : I.MenuPtr;
  81.     lastItem        - : I.MenuItemPtr;
  82.     lastSub         - : I.MenuItemPtr;
  83.  
  84.  
  85.   CONST
  86.     oom = "Out of memory";
  87.     cos = "Can't open screen";
  88.     ccs = "Can't close screen";
  89.     cow = "Can't open window";
  90.     pos = "Retry";
  91.     neg = "Cancel";
  92.     orq = "Oberon Request:";
  93.  
  94.  
  95.   PROCEDURE CreateScreen * (title       : ARRAY OF CHAR;
  96.                             le,to,wi,he : INTEGER;
  97.                             depth       : INTEGER;
  98.                             mode        : SET;
  99.                             nsProc      : NewScreenProc): I.ScreenPtr;  (* $CopyArrays- *)
  100.     VAR ns    : I.ExtNewScreen;
  101.         scr   : I.ScreenPtr;
  102.         tags2 : u.Tags2;
  103.   BEGIN
  104.     ns.ns.leftEdge:=le;
  105.     ns.ns.topEdge:=to;
  106.     ns.ns.width:=wi;
  107.     ns.ns.height:=he;
  108.     ns.ns.depth:=depth;
  109.     ns.ns.detailPen:=0;
  110.     ns.ns.blockPen:=1;
  111.     ns.ns.defaultTitle:=SYS.ADR(title);
  112.     IF title[0]=0X THEN ns.ns.defaultTitle:=NIL END;
  113.     ns.ns.viewModes:=mode;
  114.     ns.ns.type:=I.customScreen+{I.nsExtended};
  115.     ns.ns.font:=font;
  116.     ns.ns.gadgets:=NIL;
  117.     ns.ns.customBitMap:=NIL;
  118.     tags2 := u.Tags2(I.saPens,SYS.ADR("\xff\xff"),u.done,NIL);
  119.     ns.extension := SYS.ADR(tags2);
  120.     IF nsProc # NIL THEN nsProc(SYS.ADR(ns)) END;
  121.     scr:=I.OpenScreen(ns);
  122.     rq.Assert(scr # NIL,cos);
  123.     scr.userData := magic;
  124.     RETURN scr;
  125.   END CreateScreen;
  126.  
  127.  
  128.   PROCEDURE CreateWindow * (title       : ARRAY OF CHAR;
  129.                             le,to,wi,he : INTEGER;
  130.                             scr         : I.ScreenPtr;
  131.                             flags       : LONGSET;
  132.                             idcmp       : LONGSET;
  133.                             nwProc      : NewWindowProc): I.WindowPtr; (* $CopyArrays- *)
  134.     VAR nw  : I.NewWindow;
  135.         win : I.WindowPtr;
  136.   BEGIN
  137.     nw.leftEdge:=le;
  138.     nw.topEdge:=to;
  139.     nw.width:=wi;
  140.     nw.height:=he;
  141.     nw.detailPen:=-1;
  142.     nw.blockPen:=-1;
  143.     nw.idcmpFlags:=idcmp;
  144.     nw.flags:=flags;
  145.     nw.firstGadget:=NIL;
  146.     nw.checkMark:=NIL;
  147.     nw.title:=SYS.ADR(title);
  148.     IF title[0]=0X THEN nw.title:=NIL END;
  149.     nw.bitMap:=NIL;
  150.     nw.minWidth :=90;
  151.     nw.minHeight:=40;
  152.     nw.maxWidth :=-1;
  153.     nw.maxHeight:=-1;
  154.     IF scr=NIL THEN
  155.       nw.type:={I.wbenchScreen};
  156.       nw.screen:=NIL
  157.     ELSE
  158.       nw.type:=I.customScreen;
  159.       nw.screen:=scr;
  160.     END;
  161.     IF nwProc # NIL THEN nwProc(SYS.ADR(nw)) END;
  162.     win:=I.OpenWindow(nw);
  163.     rq.Assert(win # NIL,cow);
  164.     win.userData := magic;
  165.     RETURN win;
  166.   END CreateWindow;
  167.  
  168.  
  169.   PROCEDURE GetIMsg * (win:     I.WindowPtr;
  170.                        VAR mes: I.IntuiMessage;
  171.                        wait:    BOOLEAN);
  172.     VAR msg: I.IntuiMessagePtr;
  173.         waited: BOOLEAN;
  174.   BEGIN
  175.     waited := ~wait;
  176.     msg := e.GetMsg(win.userPort);
  177.     IF (msg = NIL) & wait THEN
  178.       e.WaitPort(win.userPort);
  179.       msg := e.GetMsg(win.userPort);
  180.       waited := TRUE;
  181.     END;
  182.     IF msg # NIL THEN
  183.       LOOP
  184.         mes := msg^;
  185.         e.ReplyMsg(msg);
  186.         IF (mes.class * msgFilter) = LONGSET{} THEN EXIT END;
  187.         msg := e.GetMsg(win.userPort);
  188.         IF msg = NIL THEN
  189.           IF ~ waited THEN mes.class := LONGSET{} END;
  190.           EXIT;
  191.         END;
  192.       END;
  193.     ELSE
  194.       mes.class := LONGSET{}
  195.     END;
  196.   END GetIMsg;
  197.  
  198.  
  199.   PROCEDURE AutoBorder * (le,to,wi,he:INTEGER): I.BorderPtr;
  200.     VAR b1,b2: I.BorderPtr;
  201.         dat: UNTRACED POINTER TO ARRAY 24 OF g.Point;
  202.   BEGIN
  203.     IF ~ createReqBorder THEN
  204.       INC(le); INC(to); DEC(wi,2); DEC(he,2);
  205.     END;
  206.     IF createStrBorder THEN
  207.       DEC(le,4); DEC(to,2); INC(wi,8); INC(he,4);
  208.     END;
  209.     ol.New(b1,SIZE(I.Border)*2 + SIZE(dat^));
  210.     b2  := SYS.VAL(e.APTR,SYS.VAL(LONGINT,b1) + SIZE(b1^));
  211.     dat := SYS.VAL(e.APTR,SYS.VAL(LONGINT,b2) + SIZE(b2^));
  212.     dat[1].y:=he-1;  dat[2].y:=he-2;  dat[3].x:=1;     dat[3].y:=he-2;
  213.     dat[4].x:=1;     dat[5].x:=wi-2;  dat[6].x:=wi-3;  dat[7].x:=wi-3;
  214.     dat[7].y:=he-2;  dat[8].x:=wi-3;  dat[8].y:=2;     dat[9].x:=wi-4;
  215.     dat[9].y:=2;     dat[10].x:=wi-4; dat[10].y:=he-2; dat[11].x:=3;
  216.     dat[11].y:=he-2; dat[12].x:=wi-1; dat[12].y:=he-1; dat[13].x:=wi-1;
  217.     dat[14].x:=wi-1; dat[14].y:=1;    dat[15].x:=wi-2; dat[15].y:=1;
  218.     dat[16].x:=wi-2; dat[16].y:=he-1; dat[17].x:=1;    dat[17].y:=he-1;
  219.     dat[18].x:=2;    dat[18].y:=he-1; dat[19].x:=2;    dat[19].y:=1;
  220.     dat[20].x:=3;    dat[20].y:=1;    dat[21].x:=3;    dat[21].y:=he-3;
  221.     dat[22].x:=3;    dat[22].y:=1;    dat[23].x:=wi-4; dat[23].y:=1;
  222.     b1.leftEdge:=le; b1.topEdge:=to;
  223.     b1.frontPen:=whitePen; b1.backPen:=whitePen;
  224.     b1.drawMode:=g.jam2; b1.count:=12; b1.nextBorder := b2; b1.xy:=dat;
  225.     b2.leftEdge:=le; b2.topEdge:=to;
  226.     b2.frontPen:=blackPen; b2.backPen:=blackPen;
  227.     b2.drawMode:=g.jam2; b2.count:=12; b2.xy:=SYS.ADR(dat[12]);
  228.     IF ~ createStrBorder THEN b1.count := 6; b2.count := 6 END;
  229.     RETURN b1
  230.   END AutoBorder;
  231.  
  232.  
  233.   PROCEDURE CreateBorder * (le,to: INTEGER;
  234.                             fp,bp: SHORTINT;
  235.                             dm:    SHORTSET;
  236.                             count: SHORTINT;
  237.                             xy:    ARRAY OF g.Point;
  238.                             next:  I.BorderPtr): I.BorderPtr; (* $CopyArrays- *)
  239.     VAR bord: I.BorderPtr;
  240.   BEGIN
  241.     NEW(bord);
  242.     bord.leftEdge := le; bord.topEdge  := to;
  243.     bord.frontPen := fp; bord.backPen  := bp;
  244.     bord.drawMode := dm;
  245.     bord.count := count;
  246.     bord.xy := SYS.ADR(xy);
  247.     bord.nextBorder := next;
  248.     RETURN bord;
  249.   END CreateBorder;
  250.  
  251.  
  252.   PROCEDURE SizeBorder * (border: I.BorderPtr; dx,dy: INTEGER);
  253.     VAR minX,maxX,minY,maxY: INTEGER;
  254.         x,y,medX,medY : INTEGER;
  255.         i : INTEGER;
  256.         brd   : I.BorderPtr;
  257.         vects : UNTRACED POINTER TO ARRAY 256 OF g.Point;
  258.   BEGIN
  259.     minX := MAX(INTEGER); minY := MAX(INTEGER);
  260.     maxX := MIN(INTEGER); maxY := MIN(INTEGER);
  261.     brd := border;
  262.     WHILE brd # NIL DO
  263.       vects := brd.xy;
  264.       i := 0; WHILE i < brd.count DO
  265.         x := vects[i].x; y := vects[i].y;
  266.         IF x < minX THEN minX := x END;
  267.         IF x > maxX THEN maxX := x END;
  268.         IF y < minY THEN minY := y END;
  269.         IF y > maxY THEN maxY := y END;
  270.         INC(i)
  271.       END;
  272.       brd := brd.nextBorder;
  273.     END;
  274.     medX := (minX + maxX) DIV 2;
  275.     medY := (minY + maxY) DIV 2;
  276.     brd := border;
  277.     WHILE brd # NIL DO
  278.       vects := brd.xy;
  279.       i := 0; WHILE i < brd.count DO
  280.         IF vects[i].x > medX THEN INC(vects[i].x,dx) END;
  281.         IF vects[i].y > medY THEN INC(vects[i].y,dy) END;
  282.         INC(i)
  283.       END;
  284.       brd := brd.nextBorder;
  285.     END;
  286.   END SizeBorder;
  287.  
  288.  
  289.   PROCEDURE CreateIntuiText * (fp,bp: SHORTINT;
  290.                                dm:    SHORTSET;
  291.                                le,to: INTEGER;
  292.                                font:  g.TextAttrPtr;
  293.                                text:  ARRAY OF CHAR;
  294.                                next:  I.IntuiTextPtr): I.IntuiTextPtr; (* $CopyArrays- *)
  295.     VAR it: I.IntuiTextPtr;
  296.   BEGIN
  297.     NEW(it);
  298.     it.frontPen := fp;
  299.     it.backPen  := bp;
  300.     it.drawMode := dm;
  301.     it.leftEdge := le;
  302.     it.topEdge  := to;
  303.     it.iTextFont:= font;
  304.     it.iText    := SYS.ADR(text);
  305.     it.nextText := next;
  306.     RETURN it
  307.   END CreateIntuiText;
  308.  
  309.  
  310.   PROCEDURE CreateImage * (le,to,wi,he:          INTEGER;
  311.                            depth:                INTEGER;
  312.                            data:                 ARRAY OF SYS.BYTE;
  313.                            planePick,planeOnOff: SHORTSET;
  314.                            next:                 I.ImagePtr): I.ImagePtr; (* $CopyArrays- *)
  315.     VAR im: I.ImagePtr;
  316.   BEGIN
  317.     NEW(im);
  318.     im.leftEdge := le;
  319.     im.topEdge  := to;
  320.     im.width    := wi;
  321.     im.height   := he;
  322.     im.depth    := depth;
  323.     im.imageData := SYS.ADR(data);
  324.     im.planePick := planePick;
  325.     im.planeOnOff:= planeOnOff;
  326.     im.nextImage := next;
  327.     RETURN im
  328.   END CreateImage;
  329.  
  330.  
  331.   PROCEDURE Swap(VAR a,b: SHORTINT);
  332.     VAR temp: SHORTINT;
  333.   BEGIN
  334.     temp := a; a := b; b := temp;
  335.   END Swap;
  336.  
  337.  
  338.   PROCEDURE AddGadget * (win: I.WindowPtr; gad: I.GadgetPtr);
  339.   BEGIN
  340.     SYS.SETREG(0,I.AddGadget(win,gad^,-1));
  341.   END AddGadget;
  342.  
  343.  
  344.   PROCEDURE OffGadget * (VAR gad: I.Gadget; win: I.WindowPtr);
  345.     VAR pos:INTEGER;
  346.   BEGIN
  347.     pos:=I.RemoveGadget(win,gad);
  348.     INCL(gad.flags,I.gadgDisabled);
  349.     pos:=I.AddGadget(win,gad,pos);
  350.     I.RefreshGList(SYS.ADR(gad),win,NIL,1);
  351.   END OffGadget;
  352.  
  353.  
  354.   PROCEDURE OnGadget * (VAR gad: I.Gadget; win: I.WindowPtr);
  355.     VAR fgPen: SHORTINT;
  356.         pos:INTEGER;
  357.   BEGIN
  358.     pos:=I.RemoveGadget(win,gad);
  359.     EXCL(gad.flags,I.gadgDisabled);
  360.     pos:=I.AddGadget(win,gad,pos);
  361.     fgPen := win.rPort.fgPen;
  362.     g.SetAPen(win.rPort,0);
  363.     g.RectFill(win.rPort,gad.leftEdge,gad.topEdge,gad.leftEdge+gad.width-1,gad.topEdge+gad.height-1);
  364.     g.SetAPen(win.rPort,fgPen);
  365.     I.RefreshGList(SYS.ADR(gad),win,NIL,1);
  366.   END OnGadget;
  367.  
  368.  
  369.   PROCEDURE CreateBoolGadget * (id:          INTEGER;
  370.                                 le,to,wi,he: INTEGER;
  371.                                 text:        ARRAY OF CHAR;
  372.                                 render:      e.APTR;
  373.                                 sRender:     e.APTR;
  374.                                 gadFlags:    SET;
  375.                                 actFlags:    SET): BoolGadgetPtr; (* $CopyArrays- *)
  376.     VAR tWi,tHe: INTEGER;
  377.         str: e.STRPTR;
  378.         gad: BoolGadgetPtr;
  379.         iTex:I.IntuiTextPtr;
  380.         size: LONGINT;
  381.   BEGIN
  382.     size := SIZE(BoolGadget);
  383.     IF ~ (I.boolExtend IN actFlags) THEN DEC(size,SIZE(I.BoolInfo)) END;
  384.     ol.New(gad,size);
  385.     gad.gad.leftEdge:=le; gad.gad.topEdge:=to; gad.gad.width:= wi; gad.gad.height:=he;
  386.     gad.gad.flags:=gadFlags;
  387.     gad.gad.activation:=actFlags;
  388.     IF render=autoBorder THEN
  389.       gad.gad.gadgetRender:=autoBorderProc(-1,-1,wi+2,he+2);
  390.     ELSE
  391.       gad.gad.gadgetRender:=render
  392.     END;
  393.     IF sRender=autoBorder THEN
  394.       Swap(blackPen,whitePen);
  395.       gad.gad.selectRender:=autoBorderProc(-1,-1,wi+2,he+2);
  396.       Swap(blackPen,whitePen);
  397.     ELSE
  398.       gad.gad.selectRender:=sRender
  399.     END;
  400.     IF text="" THEN
  401.       gad.gad.gadgetText := NIL;
  402.     ELSIF gadFlags * I.labelMask # {} THEN
  403.       gad.gad.gadgetText := SYS.ADR(text);
  404.     ELSE
  405.       str:=SYS.ADR(text);
  406.       iTex:=CreateIntuiText(gadgetFrontPen,gadgetBackPen,g.jam2,0,0,font,str^,NIL);
  407.       tWi:=I.IntuiTextLength(iTex^);
  408.       IF font=NIL THEN tHe:=8 ELSE tHe:=font.ySize END;
  409.       iTex.leftEdge := (wi-tWi) DIV 2;
  410.       iTex.topEdge := (he-tHe) DIV 2;
  411.       gad.gad.gadgetText:=iTex;
  412.     END;
  413.     gad.gad.gadgetType:=I.boolGadget;
  414.     gad.gad.gadgetID:=id;
  415.     IF I.boolExtend IN actFlags THEN
  416.       gad.gad.specialInfo := SYS.ADR(gad.info)
  417.     END;
  418.     RETURN gad
  419.   END CreateBoolGadget;
  420.  
  421.  
  422.   PROCEDURE SetBoolMask * (gad: BoolGadgetPtr; mask: ARRAY OF SYS.BYTE); (* $CopyArrays- *)
  423.   BEGIN
  424.     IF I.boolExtend IN gad.gad.activation THEN
  425.       gad.info.flags := {I.boolMask};
  426.       gad.info.mask := SYS.ADR(mask);
  427.     END;
  428.   END SetBoolMask;
  429.  
  430.  
  431.   PROCEDURE CreateStrGadget * (id:          INTEGER;
  432.                                le,to,wi,he: INTEGER;
  433.                                maxChars:    INTEGER;
  434.                                buffer:      ARRAY OF CHAR;
  435.                                text:        ARRAY OF CHAR;
  436.                                render:      e.APTR;
  437.                                gadFlags:    SET;
  438.                                actFlags:    SET): StrGadgetPtr; (* $CopyArrays- *)
  439.     VAR gad:  StrGadgetPtr;
  440.         tWi:  INTEGER;
  441.         st:   e.STRPTR;
  442.         iTex: I.IntuiTextPtr;
  443.         size: LONGINT;
  444.         n:    LONGINT;
  445.   BEGIN
  446.     size := SIZE(StrGadget);
  447.     IF ~((I.stringExtend IN gadFlags)OR(I.actStringExtend IN actFlags))THEN
  448.       DEC(size,SIZE(I.StringExtend))
  449.     END;
  450.     ol.New(gad,size+LONG(maxChars)*2);
  451.     gad.info.buffer := SYS.VAL(e.APTR,SYS.VAL(LONGINT,gad) + size);
  452.     gad.info.undoBuffer := SYS.VAL(e.APTR,SYS.VAL(LONGINT,gad.info.buffer) + LONG(maxChars));
  453.     gad.info.maxChars:=maxChars;
  454.     gad.gad.leftEdge:=le; gad.gad.topEdge:=to;
  455.     gad.gad.width:=wi; gad.gad.height:=he;
  456.     gad.gad.flags:=gadFlags;
  457.     gad.gad.activation:=actFlags;
  458.     n := str.Length(buffer);
  459.     IF n >= maxChars THEN n := maxChars-1 END;
  460.     IF n > 0 THEN e.CopyMem(buffer,gad.info.buffer^,n) END;
  461.     IF render=autoBorder THEN
  462.       createStrBorder := TRUE;
  463.       gad.gad.gadgetRender := autoBorderProc(-2,-2,wi+4,he+4);
  464.       createStrBorder := FALSE;
  465.     ELSE
  466.       gad.gad.gadgetRender := render
  467.     END;
  468.     IF text="" THEN
  469.       gad.gad.gadgetText:=NIL
  470.     ELSE
  471.       st:=SYS.ADR(text);
  472.       iTex:=CreateIntuiText(gadgetFrontPen,gadgetBackPen,g.jam2,0,0,font,st^,NIL);
  473.       tWi:=I.IntuiTextLength(iTex^);
  474.       iTex.leftEdge := -tWi-8;
  475.       gad.gad.gadgetText:=iTex;
  476.     END;
  477.     gad.gad.gadgetType:=I.strGadget;
  478.     gad.gad.specialInfo:=SYS.ADR(gad.info);
  479.     gad.gad.gadgetID:=id;
  480.     IF (I.stringExtend IN gadFlags) OR (I.actStringExtend IN actFlags) THEN
  481.       gad.info.extension := SYS.ADR(gad.ext);
  482.     END;
  483.     RETURN gad
  484.   END CreateStrGadget;
  485.  
  486.  
  487.   PROCEDURE SetStrExt * (gad:         StrGadgetPtr;
  488.                          font:        g.TextFontPtr;
  489.                          fp,bp:       SHORTINT;
  490.                          actFp,actBp: SHORTINT;
  491.                          initialMode: LONGSET;
  492.                          editHook:    u.HookPtr);
  493.   BEGIN
  494.     IF (I.stringExtend IN gad.gad.flags) OR (I.actStringExtend IN gad.gad.activation) THEN
  495.       gad.info.extension := SYS.ADR(gad.ext);
  496.       gad.ext.font := font;
  497.       gad.ext.pens[0] := fp;
  498.       gad.ext.pens[1] := bp;
  499.       gad.ext.activePens[0] := actFp;
  500.       gad.ext.activePens[1] := actBp;
  501.       gad.ext.initialMode := initialMode;
  502.       gad.ext.editHook := editHook;
  503.       IF editHook # NIL THEN
  504.         ol.New(gad.ext.workBuffer,gad.info.maxChars);
  505.       END;
  506.     END;
  507.   END SetStrExt;
  508.  
  509.  
  510.   PROCEDURE GadgetText * (gad: StrGadgetPtr): e.APTR;
  511.   BEGIN
  512.     RETURN gad.info.buffer;
  513.   END GadgetText;
  514.  
  515.  
  516.   PROCEDURE GadgetVal * (gad: StrGadgetPtr): LONGINT;
  517.   BEGIN
  518.     RETURN gad.info.longInt;
  519.   END GadgetVal;
  520.  
  521.  
  522.   PROCEDURE HorizPot * (gad:PropGadgetPtr; steps:INTEGER): INTEGER;
  523.   BEGIN
  524.     RETURN SHORT(SYS.LSH(I.UIntToLong(gad.info.horizPot)*I.UIntToLong(steps),-16))
  525.   END HorizPot;
  526.  
  527.  
  528.   PROCEDURE VertPot * (gad:PropGadgetPtr; steps:INTEGER): INTEGER;
  529.   BEGIN
  530.     RETURN SHORT(SYS.LSH(I.UIntToLong(gad.info.vertPot)*I.UIntToLong(steps),-16))
  531.   END VertPot;
  532.  
  533.  
  534.   PROCEDURE Pot * (val,steps: INTEGER): LONGINT;
  535.   BEGIN
  536.     IF steps <= 1 THEN RETURN 0
  537.     ELSE RETURN (I.UIntToLong(I.maxPot) * I.UIntToLong(val)) DIV I.UIntToLong(steps-1)
  538.     END;
  539.   END Pot;
  540.  
  541.  
  542.   PROCEDURE Body * (steps:INTEGER): LONGINT;
  543.   BEGIN
  544.     IF steps <= 0 THEN RETURN 0
  545.     ELSE RETURN I.UIntToLong(I.maxBody) DIV I.UIntToLong(steps) END;
  546.   END Body;
  547.  
  548.  
  549.   PROCEDURE SetProp * (gad                  : PropGadgetPtr;
  550.                        win                  : I.WindowPtr;
  551.                        req                  : I.RequesterPtr;
  552.                        horizVal,vertVal     : INTEGER;
  553.                        horizSteps,vertSteps : INTEGER);
  554.     VAR
  555.       horizBody,vertBody: LONGINT;
  556.   BEGIN
  557.     IF horizSteps = 0 THEN horizBody := I.UIntToLong(gad.info.horizBody)
  558.                       ELSE horizBody := Body(horizSteps) END;
  559.     IF vertSteps  = 0 THEN vertBody  := I.UIntToLong(gad.info.vertBody)
  560.                       ELSE vertBody  := Body(vertSteps)  END;
  561.     IF (win = NIL) & (req = NIL) THEN
  562.       (* $RangeChk- *)
  563.       gad.info.horizPot  := SHORT(Pot(horizVal,horizSteps));
  564.       gad.info.vertPot   := SHORT(Pot(vertVal,vertSteps));
  565.       gad.info.horizBody := SHORT(horizBody);
  566.       gad.info.vertBody  := SHORT(vertBody);
  567.       (* $RangeChk= *)
  568.     ELSE
  569.       I.NewModifyProp(gad^,win,req,gad.info.flags,
  570.                       Pot(horizVal,horizSteps), Pot(vertVal,vertSteps),
  571.                       horizBody,vertBody,1);
  572.     END;
  573.   END SetProp;
  574.  
  575.  
  576.   PROCEDURE CreatePropGadget * (id:          INTEGER;
  577.                                 le,to,wi,he: INTEGER;
  578.                                 horizSteps,vertSteps: INTEGER;
  579.                                 knop:        I.ImagePtr;
  580.                                 gadFlags:    SET;
  581.                                 actFlags:    SET;
  582.                                 propFlags:   SET): PropGadgetPtr;
  583.     VAR autoknob: I.ImagePtr;
  584.         gad: PropGadgetPtr;
  585.   BEGIN
  586.     NEW(gad);
  587.     gad.info.flags:=propFlags;
  588.     gad.info.horizBody:=SHORT(Body(horizSteps));
  589.     gad.info.vertBody :=SHORT(Body(vertSteps));
  590.     gad.gad.leftEdge:=le; gad.gad.topEdge:=to; gad.gad.width:=wi; gad.gad.height:=he;
  591.     gad.gad.flags:=gadFlags; gad.gad.activation:=actFlags; gad.gad.gadgetType:=I.propGadget;
  592.     IF knop#NIL THEN
  593.       gad.gad.gadgetRender:=knop
  594.     ELSE
  595.       NEW(autoknob);
  596.       gad.gad.gadgetRender:=autoknob;
  597.     END;
  598.     gad.gad.specialInfo:=SYS.ADR(gad.info); gad.gad.gadgetID:=id;
  599.     RETURN gad
  600.   END CreatePropGadget;
  601.  
  602.  
  603.   PROCEDURE CreateRequester * (le,to,wi,he: INTEGER;
  604.                                relLe,relTo: INTEGER;
  605.                                border     : I.BorderPtr;
  606.                                text       : I.IntuiTextPtr;
  607.                                flags      : SET;
  608.                                backFill   : SHORTINT): I.RequesterPtr;
  609.     VAR req: I.RequesterPtr;
  610.   BEGIN
  611.     NEW(req);
  612.     req.leftEdge := le;
  613.     req.topEdge := to;
  614.     req.width := wi;
  615.     req.height := he;
  616.     req.relLeft := relLe;
  617.     req.relTop := relTo;
  618.     IF border=autoBorder THEN
  619.       createReqBorder := TRUE;
  620.       req.reqBorder := autoBorderProc(0,0,wi,he);
  621.       createReqBorder := FALSE;
  622.     ELSE
  623.       req.reqBorder := border;
  624.     END;
  625.     req.reqText := text;
  626.     req.flags := flags;
  627.     req.backFill := backFill;
  628.     RETURN req
  629.   END CreateRequester;
  630.  
  631.  
  632.   PROCEDURE AddReqGadget * (req:I.RequesterPtr; gad:I.GadgetPtr);
  633.   BEGIN
  634.     gad.nextGadget := req.reqGadget;
  635.     req.reqGadget := gad;
  636.   END AddReqGadget;
  637.  
  638.  
  639.   PROCEDURE DefMenu * (name:        ARRAY OF CHAR;
  640.                        le,to,wi,he: INTEGER;
  641.                        enable:      BOOLEAN);    (* $CopyArrays- *)
  642.     VAR menu: I.MenuPtr;
  643.   BEGIN
  644.     NEW(menu);
  645.     menu.leftEdge:=le; menu.topEdge:=to; menu.width:=wi; menu.height:=he;
  646.     IF enable THEN menu.flags:={I.menuEnabled} END;
  647.     menu.menuName:=SYS.ADR(name);
  648.     IF lastMenu=NIL THEN firstMenu:=menu ELSE lastMenu.nextMenu:=menu END;
  649.     lastMenu:=menu; lastItem:=NIL;
  650.   END DefMenu;
  651.  
  652.  
  653.   PROCEDURE DefItem * (fill:        ARRAY OF SYS.BYTE;
  654.                        le,to,wi,he: INTEGER;
  655.                        itemPen:     SHORTINT;
  656.                        mutEx:       LONGSET;
  657.                        cmd:         CHAR;
  658.                        flags:       SET);   (* $CopyArrays- *)
  659.     VAR item: I.MenuItemPtr;
  660.         str : e.STRPTR;
  661.   BEGIN
  662.     NEW(item);
  663.     item.leftEdge:=le; item.topEdge:=to; item.width:=wi; item.height:=he;
  664.     item.flags:=flags;
  665.     item.mutualExclude:=mutEx;
  666.     IF I.itemText IN flags THEN
  667.       str:=SYS.ADR(fill);
  668.       item.itemFill:=CreateIntuiText(itemPen,0,g.jam1,itemLeftEdge,itemTopEdge,font,str^,NIL);
  669.     ELSE
  670.       item.itemFill:=SYS.ADR(fill);
  671.     END;
  672.     item.command:=cmd;
  673.     IF lastItem=NIL THEN lastMenu.firstItem:=item
  674.                     ELSE lastItem.nextItem:=item END;
  675.     lastItem:=item; lastSub:=NIL;
  676.   END DefItem;
  677.  
  678.  
  679.   PROCEDURE DefSub * (fill:        ARRAY OF SYS.BYTE;
  680.                       le,to,wi,he: INTEGER;
  681.                       itemPen:     SHORTINT;
  682.                       mutEx:       LONGSET;
  683.                       cmd:         CHAR;
  684.                       flags:       SET);    (* $CopyArrays- *)
  685.     VAR item: I.MenuItemPtr;
  686.         str : e.STRPTR;
  687.   BEGIN
  688.     NEW(item);
  689.     item.leftEdge:=le; item.topEdge:=to; item.width:=wi; item.height:=he;
  690.     item.flags:=flags;
  691.     item.mutualExclude:=mutEx;
  692.     IF I.itemText IN flags THEN
  693.       str:=SYS.ADR(fill);
  694.       item.itemFill:=CreateIntuiText(itemPen,0,g.jam1,itemLeftEdge,itemTopEdge,font,str^,NIL);
  695.     ELSE
  696.       item.itemFill:=SYS.ADR(fill);
  697.     END;
  698.     item.command:=cmd;
  699.     IF lastSub=NIL THEN lastItem.subItem:=item
  700.                    ELSE lastSub.nextItem:=item END;
  701.     lastSub:=item;
  702.   END DefSub;
  703.  
  704.  
  705.   PROCEDURE LastItem * (): I.MenuItemPtr;
  706.   BEGIN
  707.     IF lastSub = NIL THEN RETURN lastItem
  708.                      ELSE RETURN lastSub END;
  709.   END LastItem;
  710.  
  711.  
  712.   PROCEDURE InstallMenuStrip * (win: I.WindowPtr): I.MenuPtr;
  713.   BEGIN
  714.     IF ~ I.SetMenuStrip(win,firstMenu^) THEN HALT(20) END;
  715.     lastMenu := NIL;
  716.     RETURN firstMenu
  717.   END InstallMenuStrip;
  718.  
  719.  
  720.   PROCEDURE DeleteWindow * (VAR win: I.WindowPtr);
  721.   BEGIN
  722.     IF win # NIL THEN
  723.       IF win.menuStrip # NIL THEN I.ClearMenuStrip(win) END;
  724.       I.CloseWindow(win);
  725.       win := NIL;
  726.     END;
  727.   END DeleteWindow;
  728.  
  729.  
  730.   PROCEDURE DeleteScreen * (VAR scr: I.ScreenPtr): BOOLEAN;
  731.     VAR ok: BOOLEAN;
  732.   BEGIN
  733.     ok := TRUE;
  734.     IF scr # NIL THEN
  735.       IF I.int.libNode.version >= 36 THEN
  736.         ok := I.CloseScreen(scr);
  737.       ELSE
  738.         ok := scr.firstWindow=NIL;
  739.         IF ok THEN I.OldCloseScreen(scr) END;
  740.       END;
  741.       IF ok THEN scr := NIL END;
  742.     END;
  743.     RETURN ok;
  744.   END DeleteScreen;
  745.  
  746.  
  747.   PROCEDURE Cleanup;
  748.     VAR win,nextwin: I.WindowPtr;
  749.         scr,nextscr: I.ScreenPtr;
  750.         ok: BOOLEAN;
  751.   BEGIN
  752.     REPEAT
  753.       ok := TRUE;
  754.       e.Forbid;
  755.       LOOP
  756.         scr := I.int.firstScreen;
  757.         WHILE scr # NIL DO
  758.           nextscr := scr.nextScreen;
  759.           win := scr.firstWindow;
  760.           WHILE win # NIL DO
  761.             nextwin := win.nextWindow;
  762.             IF win.userData=SYS.VAL(e.APTR,magic) THEN DeleteWindow(win) END;
  763.             win := nextwin;
  764.           END;
  765.           IF scr.userData=SYS.VAL(e.APTR,magic) THEN
  766.             IF ~ DeleteScreen(scr) THEN ok:=FALSE; EXIT END;
  767.           END;
  768.           scr := nextscr;
  769.         END;
  770.         EXIT;
  771.       END;
  772.       e.Permit;
  773.       IF ~ ok THEN
  774.         IF rq.Request(orq,ccs,"",pos) THEN END;
  775.       END;
  776.     UNTIL ok;
  777.   END Cleanup;
  778.  
  779.  
  780.  
  781. BEGIN
  782.  
  783.   createReqBorder := FALSE;
  784.   createStrBorder := FALSE;
  785.   lastMenu        := NIL;
  786.   font            := SYS.ADR(topaz80);
  787.   autoBorderProc  := AutoBorder;
  788.   itemLeftEdge    := 2;
  789.   itemTopEdge     := 1;
  790.   gadgetFrontPen  := 1;
  791.   gadgetBackPen   := 0;
  792.   blackPen        := 1;
  793.   whitePen        := 2;
  794.   msgFilter       := LONGSET{};
  795.   magic           := SYS.VAL(LONGINT,ol.Me) + SYS.VAL(LONGINT,"ISUP");
  796.  
  797. CLOSE
  798.  
  799.   Cleanup;
  800.  
  801. END IntuiSupport.
  802.  
  803.